# configure-bind.pm
# Copyright (C) 2006  Stephane Alnet
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 3
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
# 

#
# For more information: http://carrierclass.net/
#
use strict; use warnings;

package CCNv2::Provision::Application::bind;
use base qw(CCNCore::Provision::Application::bind);

=pod

    make_naptr($name)

        Build a SIP/UDP NAPTR for $name

=cut

sub make_naptr($)
{
    my $name = shift;
    return <<"EOT";
; ${name} IN      NAPTR   0 0 "s" "SISP+D2T" "" _sips._tcp.${name}
; ${name} IN      NAPTR   1 0 "s" "SIP+D2T"  "" _sip._tcp.${name}
${name} IN      NAPTR   2 0 "s" "SIP+D2U"  "" _sip._udp.${name}
EOT
}

=pod

    make_sipsrv($name,$port,$target)
    
        Build a SIP/UDP SRV record for $name going to $port/$target

=cut

sub make_sipsrv($$$)
{
    my $name = shift;
    my $port = shift;
    my $target = shift;
    return <<"EOT";
; _sips._tcp.${name}   IN  SRV 50 0 ${port} ${target}.
; _sip._tcp.${name}    IN  SRV 50 0 ${port} ${target}.
_sip._udp.${name}    IN  SRV 50 0 ${port} ${target}.
EOT
}

=pod
    make_sipsrv_primary($name,$port,$target)
    
        Build a SIP/UDP srv primary target
=cut

sub make_sipsrv_primary($$$)
{
    my $name = shift;
    my $port = shift;
    my $target = shift;
    return <<"EOT";
; _sips._tcp.${name}   IN  SRV 10 0 ${port} ${target}.
; _sip._tcp.${name}    IN  SRV 10 0 ${port} ${target}.
_sip._udp.${name}    IN  SRV 10 0 ${port} ${target}.
EOT
}



sub anchor_system()
{
    my $self = shift;
    my $dnsconf = '';

    # Generate mediaproxy SRV records for all mediaproxy servers.
    $self->sql_do_for( <<'SQL', $self->p->system_pk,
        SELECT pk, mp_member FROM mp_servers WHERE system = ?
SQL
    sub
    {
        my ($server_pk,$mp_member) = @_;
        my $server_dns  = $self$self->p->make_server_name($server_pk);
        my $cluster_dns = $self->p->make_cluster_name($mp_member,'mp');
        $dnsconf .= <<"EOT";
_mediaproxy._tcp.${cluster_dns}.  IN SRV   50  25 25060 ${server_dns}.
EOT
    });


    # By default proxy_dispatcher will look for the proxy name first.
    # (Actually it looks for the domain in the RURI.)
    # Generate mediaproxy SRV records for all proxy clusters.
    $self->sql_do_for( q(SELECT pk, mp_cluster FROM px_clusters WHERE system = ? AND mp_cluster IS NOT NULL), $self->p->system_pk,
    sub
    {
        my $px_cluster_name = $self->p->make_cluster_name(shift,'px');
        # Identify the media-proxy cluster associated with this proxy cluster.
        my $mp_cluster = shift;

        # Identify the servers which are part of this mediaproxy cluster.
        $self->sql_do_for(  q(SELECT pk FROM server WHERE mp_member = ?), $mp_cluster,
        sub
        {
            my $server_pk = shift;
            my $server_dns = $self$self->p->make_server_name($server_pk);
            $dnsconf .= <<"EOT";
_mediaproxy._tcp.${px_cluster_name}.  IN SRV   50  25 25060 ${server_dns}.
EOT
        }); # foreach @servers
    });

    # Generate SIP SRV records for servers in proxy clusters.
    $self->sql_do_for( q(SELECT px_member, pk FROM px_servers WHERE system = ?), $self->p->system_pk,
    sub
    {
        my $px_cluster_dns = $self->p->make_cluster_name(shift,'px');
        my $px_server_dns = $self$self->p->make_server_name(shift);
        $dnsconf .= make_sipsrv($px_cluster_dns,5060,$px_server_dns);
    });

    # Generate SIP SRV records for servers in call-processing clusters.
    $self->sql_do_for( q(SELECT pk FROM cp_clusters WHERE system = ?), $self->p->system_pk, 
    sub
    {
        my $cluster_pk = shift;

        # "cpc" is used by trunks to select a cluster (trunks have no pools associated with them, so they can't use
        # <pool>.cp.<sysname> like phones do).
        for my $type (qw(cpc vm er cf mn qu))
        {
            my $cluster_dns = $self->p->make_cluster_name($cluster_pk,$type);
            $dnsconf .= make_naptr($cluster_dns);
        }

        $self->sql_do_for( q(SELECT pk FROM server WHERE system = ? AND cp_member = ?), $self->p->system_pk, $cluster_pk,
        sub
        {
            my $server_pk = shift;
            my $server_dns = $self$self->p->make_server_name($server_pk);

            for my $type (qw(cpc vm er cf mn qu))
            {
                my $cluster_dns = $self->p->make_cluster_name($cluster_pk,$type);
                $dnsconf .= make_sipsrv($cluster_dns,5062,$server_dns);
            }
        });
    });

    # TGw uses this.
    $self->sql_do_for( q(SELECT pk, px_cluster FROM trunk WHERE type = 'gateway' AND system = ?), $self->p->system_pk,
    sub
    {
        my $trunk_pk = shift;
        my $px_cluster = shift;
        $dnsconf .= make_naptr("gw${trunk_pk}.gw");
        $self->sql_do_for( q(SELECT pk FROM server WHERE system = ? AND px_member = ?), $self->p->system_pk, $px_cluster,
        sub
        {
            my $server_pk = shift;
            my $server_name = $self$self->p->make_server_name($server_pk);
            $dnsconf .= make_sipsrv("gw${trunk_pk}.gw",5060,$server_name);
        });
    });


    # Generate per-pool SRV records.
    $self->sql_do_for( <<'SQL', $self->p->system_pk,
        SELECT pk, enterprise, cp_cluster, cp_primary, px_cluster, px_primary 
        FROM pool WHERE enterprise IN (SELECT pk FROM enterprise WHERE system = ?);
SQL
    sub
    {
        my ($pool_pk, $enterprise_pk, $pool_cp, $cp_primary, $pool_px, $px_primary) = @_;

        $dnsconf .= make_naptr("${pool_pk}.cp");

        $self->sql_do_for( q(SELECT pk FROM server WHERE system = ? AND cp_member = ?), $self->p->system_pk, $pool_cp,
        sub
        {
            my $server_pk = shift;
            my $server_name = $self$self->p->make_server_name($server_pk);

            if( defined $cp_primary and $server_pk eq $cp_primary )
            {
                $dnsconf .= make_sipsrv_primary("${pool_pk}.cp",5062,$server_name);
            }
            else
            {
                $dnsconf .= make_sipsrv("${pool_pk}.cp",5062,$server_name);
            }
        });

        $dnsconf .= make_naptr("${pool_pk}.px");

        $self->sql_do_for( q(SELECT pk FROM server WHERE system = ? AND px_member = ?), $self->p->system_pk, $pool_px,
        sub
        {
            my $server_pk = shift;
            my $server_name = $self$self->p->make_server_name($server_pk);
            if( defined $px_primary and $server_pk eq $px_primary )
            {
                $dnsconf .= make_sipsrv_primary("${pool_pk}.px",5060,$server_name);
            }
            else
            {
                $dnsconf .= make_sipsrv("${pool_pk}.px",5060,$server_name);
            }
        });
    });


    return $dnsconf;
}

1;